home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / wwwMenu.tcl < prev   
Encoding:
Text File  |  1999-07-11  |  24.5 KB  |  1,004 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "wwwMenu.tcl"
  6.  #                                    created: 30/4/97 {11:04:46 am} 
  7.  #                                last update: 18/3/1999 {4:57:05 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501, USA
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Copyright (c) 1997-1998  Vince Darley, all rights reserved
  14.  #  
  15.  #  A simple text-only WWW browser.  Since Alpha can't use the http
  16.  #  protocol, it can only browse files locally, but could be easily
  17.  #  extended if/when Alpha upgrades to Tcl8.0
  18.  #  
  19.  #  Basic features: handles most common html tags, and has a 
  20.  #  history list and a back/forward capability.  Can handle mailto,
  21.  #  ftp and java applets itself; all other stuff is optionally
  22.  #  shipped off to Internet Config.
  23.  #  
  24.  #  Use the cursor keys, mouse or cmd-[] to move from web page
  25.  #  to web page as follows:
  26.  #  
  27.  #    <- or cmd-[   goto previous page     
  28.  #    cmd-]         goto next page
  29.  #    -> or return  goto current link      
  30.  #    up/down arrow highlight previous/next link
  31.  #    mouse-click   goto clicked-upon link
  32.  #    
  33.  #  You can also select 'view source' from the menu.  Many keys
  34.  #  are also bound to imitate the browser 'lynx'.
  35.  #  
  36.  # Advanced features:
  37.  # 
  38.  #  ctrl-return allows you to edit the original of the link currently
  39.  #  selected.
  40.  #  
  41.  #  Using the WWW mode preferences you can ask Alpha to handle 
  42.  #  some URL types internally (currently mailto: and ftp: only).
  43.  #  Also Java applets may be sent to your javaviewer application
  44.  #  (for example the 'Apple Applet Runner' which is free from apple).
  45.  # 
  46.  # To Do:
  47.  # 
  48.  #  Could be faster (i.e. it's probably useless on 680x0 machines), 
  49.  #  and it would be nice if Alpha added Tcl's socket capability.  
  50.  #  However it's reasonably useful for browsing local HTML 
  51.  #  documentation.
  52.  # 
  53.  # Installation: (requires Alpha 7.0b1)
  54.  # 
  55.  #  It's most useful if you either make the wwwMenu a 
  56.  #  global menu (Config->Global->PackageMenus...), or if you attach a
  57.  #  key binding in your prefs.tcl to view a file; something like
  58.  #  this:
  59.  #      # Bind cmd-F12 to parse a file
  60.  #      Bind 0x6f <c> wwwParseFile
  61.  # 
  62.  # This file is copyright Vince Darley 1997, but freely distributable
  63.  # provided you note any modifications you make below.  Please send
  64.  # me bug fixes and improvements.
  65.  # ###################################################################
  66.  ##
  67.  
  68. alpha::menu wwwMenu 1.2 "global WWW HTML" "•286" {
  69.     addMode WWW wwwMenu {*.www} wwwMenu
  70.     ensureset javaviewerSig "WARZ"
  71.     set {newDocTypes(New Web Browser)} wwwParseFile
  72. } {wwwMenu} {} maintainer {
  73.     "Vince Darley" vince@santafe.edu <http://www.santafe.edu/~vince/>
  74. } uninstall {this-file} help {
  75.     Browse local html pages inside Alpha
  76. }
  77.  
  78. newPref v header1Color blue WWW
  79. newPref v header2Color red WWW
  80. newPref v header3Color red WWW
  81. newPref v linkColor green WWW
  82. newPref v visitedLinkColor cyan WWW
  83. newPref f mailtoLinksInternal 0 WWW
  84. newPref f ftpLinksInternal 0 WWW
  85. newPref f runJavaAppletsDirectly 0 WWW
  86. newPref f wwwSendRemoteLinks 0 WWW
  87.  
  88. # To perform a special action with a new URL type, add an array
  89. # entry indicating the procedure to be called with the remainder
  90. # of the URL.  You must also add a global variable or modeVar
  91. # as above so that the user can choose whether Alpha should handle
  92. # that type via the given procedure.  If any of this fails, the
  93. # URL is just given to Internet Config to deal with.  Note that
  94. # 'file' URL's are always handled internally.
  95. set wwwUrlAction(mailto) "mailNewMsg"
  96. set wwwUrlAction(ftp)    "ftpWWWLink"
  97. set wwwUrlAction(file)   "fileWWWLink"
  98. set wwwUrlAction(java)   "javaWWWLink"
  99. set _wwwAlwaysInternal [list file java]
  100.  
  101. proc wwwMenu {} {}
  102.  
  103. Menu -n $wwwMenu -p wwwMenuProc -M WWW {
  104.     "/S<U<OswitchToBrowser"
  105.     "(-"
  106.     "viewHtmlFile…"
  107.     "viewThisFile"
  108.     "viewSource"
  109.     "/a<S<EselectLink"
  110.     "/a<S<BmodifyLink"
  111.     "/\[back"
  112.     "/\]forward"
  113.     "reload"
  114.     {Menu -m -n gotoPage -p wwwMenuProc {
  115.     }}
  116.     "forgetHistory"
  117. }
  118.  
  119. # Bind various keys to imitate lynx.
  120.   ## 
  121.    #                         +++ Keystroke Commands    +++
  122.    #  
  123.    # MOVEMENT:      Down arrow     - Highlight next topic
  124.    #              Up arrow         - Highlight previous topic
  125.    #              Right    arrow,     - Jump    to highlighted topic
  126.    #              Return, Enter
  127.    #              Left arrow     - Return to previous topic
  128.    #         
  129.    # SCROLLING:      +                 - Scroll down to next page    (Page-Down)
  130.    #              -                 - Scroll up to    previous page (Page-Up)
  131.    #              SPACE             - Scroll down to next page    (Page-Down)
  132.    #              b                 - Scroll up to    previous page (Page-Up)
  133.    #              CTRL-A         - Go to first page    of the current document    (Home)
  134.    #              CTRL-E         - Go to last page of the current document (End)
  135.    #              CTRL-B         - Scroll up to    previous page (Page-Up)
  136.    #              CTRL-F         - Scroll down to next page    (Page-Down)
  137.    #              CTRL-N         - Go forward two lines    in the current document
  138.    #              CTRL-P         - Go back two lines in    the    current    document
  139.    #              )                 - Go forward half a page in the current document
  140.    #              (                 - Go back half    a page in the current document
  141.    ##
  142. Bind 0x7d wwwDown WWW
  143. Bind 0x7e wwwUp WWW
  144. Bind 0x7c wwwSelectLink WWW
  145. Bind 0x24 wwwSelectLink WWW
  146. Bind 0x34 wwwSelectLink WWW
  147. Bind 0x7b wwwBack WWW
  148. Bind 0x24 <z> wwwModifyLink WWW
  149. Bind 0x24 <o> wwwEditLinkedDocument WWW
  150. Bind 0x79 "wwwKey pageForward" WWW
  151. Bind 0x74 "wwwKey pageBack" WWW 
  152. Bind 0x31 "wwwKey pageForward" WWW
  153. Bind '+' "wwwKey pageForward" WWW
  154. Bind '-' "wwwKey pageBack" WWW
  155. Bind 'b' "wwwKey pageForward" WWW
  156. Bind 0x7e <c> "wwwKey Home" WWW
  157. Bind 0x7d <c> "wwwKey End" WWW
  158. Bind 'a' <z> "wwwKey Home" WWW
  159. Bind 'e' <z> "wwwKey End" WWW
  160. Bind 'b' <z> "wwwKey pageBack" WWW
  161. Bind 'f' <z> "wwwKey pageForward" WWW
  162. Bind 'n' <z> "wwwKey twoLinesForward" WWW
  163. Bind 'p' <z> "wwwKey twoLinesBack" WWW
  164. Bind ')' "wwwKey halfPageForward" WWW
  165. Bind '(' "wwwKey halfPageBack" WWW
  166.  
  167. Bind 'e' "wwwMenuProc x viewSource" WWW
  168.  
  169. Bind 'g' wwwParseFile WWW
  170. Bind 'c' wwwCopyLinkLocation WWW
  171. Bind '\t' wwwDown WWW
  172. Bind 'r' wwwReload WWW
  173.  
  174. set wwwSendRemoteLinks 0
  175.  
  176. set _wwwHistory ""
  177. set _wwwHpos -1
  178. set _wwwVisited ""
  179. set _wwwPre 0
  180.  
  181. ## 
  182.  # -------------------------------------------------------------------------
  183.  # 
  184.  # "wwwKey" --
  185.  # 
  186.  #  Handle page-movement key bindings.
  187.  # -------------------------------------------------------------------------
  188.  ##
  189. proc wwwKey {key} {
  190.     if {[set a [_wwwKeyPosition $key]] != ""} {
  191.         _wwwHighlightLink [lindex [wwwGetCurrentLink] $a]
  192.     }
  193. }
  194.  
  195. proc _wwwKeyPosition {key} {
  196.     switch $key {
  197.         "Home" {
  198.             goto [minPos]
  199.             wwwHighlightLink 0
  200.             return ""
  201.         }
  202.         "End" {
  203.             goto [maxPos]
  204.             wwwHighlightLink -1
  205.             return ""
  206.         }
  207.         "pageBack" {
  208.             pageBack
  209.             return 0
  210.         }
  211.         "pageForward" {
  212.             pageForward
  213.             return 1
  214.         }
  215.         default {
  216.             set p [getPos]
  217.             switch $key {
  218.                 "twoLinesForward" {
  219.                     scrollDownLine
  220.                     scrollDownLine
  221.                     return [_wwwEnsureOn $p]
  222.                 }
  223.                 "twoLinesBack" {
  224.                     scrollUpLine
  225.                     scrollUpLine
  226.                     return [_wwwEnsureOn $p]
  227.                 }
  228.                 "halfPageForward" {
  229.                     getWinInfo a
  230.                     set lines $a(linesdisp)
  231.                     set top $a(currline)
  232.                     set q [rowColToPos [expr $top + ${lines}/2] 0]
  233.                     goto [rowColToPos [expr $top + $lines + ($lines /2) -1] 0]
  234.                     return [_wwwEnsureOn $p 1]
  235.                 }
  236.                 "halfPageBack" {
  237.                     getWinInfo a
  238.                     set lines $a(linesdisp)
  239.                     set top $a(currline)
  240.                     set q [rowColToPos [expr $top - ${lines}/2] 0]
  241.                     goto [rowColToPos [expr $top - ${lines}/2] 0]
  242.                     return [_wwwEnsureOn $p 1]
  243.                 }
  244.             }
  245.             
  246.         }
  247.         
  248.     }
  249. }
  250.  
  251. ## 
  252.  # -------------------------------------------------------------------------
  253.  # 
  254.  # "_wwwEnsureOn" --
  255.  # 
  256.  #  Make sure pos 'p' lies in the visible window area.  If it does not,
  257.  #  goto the closest position 'q' which does.  If 'force', then 
  258.  #  provided 'p' is on-window, we goto it.  Return values indicate
  259.  #  in which direction to look for the rest of the visible window.
  260.  # -------------------------------------------------------------------------
  261.  ##
  262. proc _wwwEnsureOn {p {force 0}} {
  263.     getWinInfo a
  264.     set lines $a(linesdisp)
  265.     set top $a(currline)
  266.     set q [rowColToPos $top 0]
  267.     if {[pos::compare $q > $p]} { 
  268.         goto $q
  269.         return 1
  270.     } 
  271.     set q [pos::math [rowColToPos [expr $top + $lines] 0] - 1]
  272.     if {[pos::compare $q < $p]} {
  273.         goto $q
  274.         return 0
  275.     } 
  276.     if {$force} {
  277.         goto $p
  278.         return 0
  279.     } else {
  280.         return ""
  281.     }
  282. }
  283.                 
  284.  
  285. proc wwwMenuProc {menu item} {
  286.     if {$menu == "gotoPage"} {
  287.         # goto a history item
  288.         global _wwwHistory _wwwHpos
  289.         set pos [minPos]
  290.         foreach i $_wwwHistory {
  291.             if {[lindex $i 1] == $item} {
  292.                 break
  293.             }
  294.             incr pos
  295.         }
  296.         if {$pos >= [llength $_wwwHistory]} {
  297.             alertnote "Sorry, I couldn't find that page!"
  298.         }
  299.         set _wwwHpos $pos
  300.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  301.         _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  302.         return
  303.     }
  304.     
  305.     switch $item {
  306.         "switchToBrowser" {
  307.             global browserSig
  308.             app::launchFore $browserSig
  309.         }
  310.         "viewHtmlFile" {
  311.             wwwParseFile [getfile "View which file"]
  312.         }
  313.         "viewThisFile" {
  314.             global mode
  315.             if {$mode == "HTML"} {
  316.                 wwwParseFile [win::Current]
  317.             } else {
  318.                 message "File must be HTML to be viewed!."
  319.                 beep
  320.             }
  321.         }
  322.         "viewSource" {
  323.             global mode
  324.             if {$mode == "WWW"} {
  325.                 global _wwwHistory _wwwHpos
  326.                 if {[catch {file::openQuietly [lindex [lindex $_wwwHistory $_wwwHpos] 0]}]} {
  327.                     alertnote "Sorry, I couldn't find that page!"
  328.                 }
  329.             }
  330.             
  331.         }
  332.         "forgetHistory" {
  333.             global _wwwHistory _wwwHpos _wwwVisited
  334.             set _wwwHistory ""
  335.             set _wwwHpos -1
  336.             set _wwwVisited ""
  337.             Menu -m -n gotoPage -p wwwMenuProc {}
  338.         }
  339.         default {
  340.             eval www[string toupper [string index $item 0]][string range $item 1 end]
  341.         }
  342.         
  343.     }
  344.     
  345. }
  346.  
  347. proc wwwParseFile {{f ""} {title ""}} {
  348.     if {$f == ""} { set f [getfile "View which file"] }
  349.     _wwwParseFile $f $title
  350.     global _wwwHistory _wwwHpos
  351.     if {[set i [lsearch -glob $_wwwHistory [list * [win::Current]]]] != -1} {
  352.         set _wwwHpos $i
  353.     } else {        
  354.         set _wwwHistory [lrange $_wwwHistory 0 $_wwwHpos]
  355.         incr _wwwHpos
  356.         lappend _wwwHistory [list $f [win::Current]]
  357.         foreach f $_wwwHistory {
  358.             lappend g [lindex $f 1]
  359.         }
  360.         Menu -m -n gotoPage -p wwwMenuProc $g
  361.     }
  362.     _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  363.     wwwVisited $f
  364. }
  365.  
  366. proc _wwwParseFile {f {title ""}} {
  367.     if {$title != ""} {
  368.         global wwwWhere
  369.         if {[info exists wwwWhere($title)]} {
  370.             if {![catch {bringToFront $title}]} {
  371.                 return
  372.             }
  373.         }
  374.     }
  375.     if {[catch {
  376.         set fin [open $f r]
  377.         set t [read $fin]
  378.         close $fin
  379.     }]} {
  380.         catch {close $fin}
  381.         beep
  382.         alertnote "Sorry, I couldn't find and/or read that file."
  383.         error ""
  384.     }
  385.     message "Rendering…"
  386.     wwwParseText $t $f
  387.     message ""
  388. }
  389.  
  390. proc wwwParseText {t {f ""}} {
  391.     set title "no-title"
  392.     regexp -nocase {<TITLE>(.*)</TITLE>} $t dummy title
  393.     global wwwWhere
  394.     if {[info exists wwwWhere($title)]} {
  395.         if {![catch {bringToFront $title}]} {
  396.             return
  397.         } else {
  398.             wwwNewWindow $t $title
  399.             return
  400.         }
  401.     }
  402.     set "wwwWhere($title)" $f
  403.     wwwNewWindow $t $title
  404. }
  405.  
  406. proc wwwNewWindow {t title} {
  407.     set title [new -n $title -m WWW]
  408.     # ignore dirty flag and undo off.
  409.     setWinInfo shell 1
  410.     regexp -nocase {<BODY[^>]*>(.*)</BODY>} $t dummy t
  411.     catch {_wwwParseIntoWindow $t}
  412.     regsub -all {[][]} $title {\\&} title
  413.     setWinInfo read-only 1    
  414.     #setWinInfo dirty 0
  415.     goto [minPos]
  416. }
  417.  
  418. set wwwHtmlToStyle(B) bold
  419. set wwwHtmlToStyle(I) italic
  420. set wwwHtmlToStyle(U) underline
  421. set wwwHtmlToStyle(BIG) outline
  422. set wwwHtmlToStyle(SMALL) condensed
  423. set wwwHtmlToStyle(EM) italic
  424. set wwwHtmlToStyle(STRONG) bold
  425.  
  426. proc _wwwRemoveCrap {tt} {
  427.     upvar $tt t
  428.     regsub -all {alt="([^"]*)"[^>]*>} $t {>\1} t
  429.     regsub -all {<img[^>]*>} $t "" t
  430.     while {[set p [string first "<!--" $t]] != -1} {
  431.         set p2 [string first "-->" $t]
  432.         set t "[string range $t 0 [expr $p -1]][string range $t [expr $p2 + 3] end]"
  433.     }
  434.     while {[set p [string first "<FORM" $t]] != -1} {
  435.         set p2 [string first "/FORM>" $t]
  436.         set t "[string range $t 0 [expr $p -1]][string range $t [expr $p2 + 6] end]"
  437.     }        
  438. }
  439.  
  440. proc _wwwParseIntoWindow {t} {
  441.     global _wwwIndentation _wwwIndent
  442.     set _wwwIndentation 0
  443.     set _wwwIndent ""
  444.     _wwwRemoveCrap t
  445.     _wwwParseHtml $t
  446. }
  447.  
  448. proc _wwwParseHtml {t} {
  449.     global _wwwIndentation _wwwIndent
  450.     while {[regexp {^([^<]*(<[<>][^<]*)*)<([^<>][^>]*)> *(.*)$} $t dummy first dmy html t]} {
  451.         wrapInsertText $first
  452.         switch -regexp [string toupper $html] {
  453.             "^A\\s+HREF\\s*=.*" {
  454.                 set html [string range $html [expr 1+ [string first "=" $html]] end]
  455.                 if {[regexp -nocase {^([^<]*)</A>(.*)$} $t "" name t]} {
  456.                     wwwMakeLinkWord $name $html
  457.                 }
  458.             }
  459.             "^A\\s+NAME\\s*=.*" {
  460.                 set html [string range $html [expr 1+ [string first "=" $html]] end]
  461.                 set html [string trim $html " \""]
  462.                 setNamedMark $html [getPos] [getPos] [getPos]
  463.             }
  464.             "^(B|I|U|BIG|SMALL|EM|STRONG)\$" {
  465.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t "" name t]} {
  466.                     global wwwHtmlToStyle
  467.                     wwwMakeColourWord $name $wwwHtmlToStyle([string toupper $html]) 12
  468.                 }
  469.             }
  470.             "^/TR" {
  471.                 insertText "\r"
  472.             }
  473.             "^(UL|DL|OL|BLOCKQUOTE)" {
  474.                 _wwwNewLineIfNecessary
  475.                 incr _wwwIndentation 3
  476.                 append _wwwIndent "   "
  477.                 if {[string toupper $html] == "OL"} {
  478.                     global _wwwOLcount$_wwwIndentation
  479.                     set _wwwOLcount$_wwwIndentation 1
  480.                 }
  481.             }
  482.             "^HR" {
  483.                 _wwwBreakIfNecessary
  484.                 insertText "     ----------------------------------------------------------------     \r"
  485.             }            
  486.             "^TD" {
  487.                 #insertText " "
  488.             }
  489.             "^APPLET" {
  490.                 _wwwSplit t </APPLET> pre
  491.                 if {![regexp -nocase {code *= *([^.]*)\.class} $html dummy class]} {
  492.                     set class "applet"
  493.                 }
  494.                 wwwMakeLinkWord "Run java $class" "\"${class}.java\""
  495.             }
  496.             "^PRE" {
  497.                 global _wwwPre
  498.                 set _wwwPre 1
  499.                 #_wwwSplit t </PRE> pre
  500.                 #insertText $pre
  501.             }
  502.             "^/PRE" {
  503.                 global _wwwPre
  504.                 set _wwwPre 0
  505.             }
  506.             "^/(UL|DL|OL|BLOCKQUOTE)" {
  507.                 _wwwNewLineIfNecessary
  508.                 if {[string toupper $html] == "/OL"} {
  509.                     global _wwwOLcount$_wwwIndentation
  510.                     unset _wwwOLcount$_wwwIndentation
  511.                 }    
  512.                 incr _wwwIndentation -3
  513.                 set _wwwIndent [string range $_wwwIndent 3 end]
  514.             }
  515.             "^LI" {
  516.                 _wwwNewLineIfNecessary
  517.                 global _wwwOLcount$_wwwIndentation
  518.                 if {[info exists _wwwOLcount$_wwwIndentation]} {
  519.                     insertText "[string range ${_wwwIndent} 2 end][set _wwwOLcount$_wwwIndentation] "
  520.                     incr _wwwOLcount$_wwwIndentation
  521.                 } else {
  522.                     insertText "[string range ${_wwwIndent} 2 end]• "
  523.                 }
  524.             }
  525.             "^DT" {
  526.                 _wwwNewLineIfNecessary
  527.                 #_wwwSplit t <DD> pre
  528.                 insertText "[string range ${_wwwIndent} 2 end]"
  529.             }
  530.             "^DD" {
  531.                 insertText " "
  532.             }
  533.             "^P" {
  534.                 _wwwBreakIfNecessary
  535.                 set t [string trimleft $t]
  536.             }
  537.             "^BR( .*)?" {
  538.                 if {[lindex [posToRowCol [getPos]] 1] != 0} {
  539.                     insertText "\r"
  540.                 }
  541.                 set t [string trimleft $t]
  542.             }
  543.             "^H\[0-9\]" {
  544.                 set html [lindex $html 0]
  545.                 set num [string range $html 1 end]
  546.                 _wwwBreakIfNecessary
  547.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t dummy name t]} {
  548.                     switch $num {
  549.                         1 {
  550.                             insertText "\r"
  551.                             global header1Color
  552.                             wwwMakeColourWord $name $header1Color 0 outline
  553.          
  554.                         }
  555.                         2 {
  556.                             global header2Color
  557.                             wwwMakeColourWord $name $header2Color 0 bold
  558.                         }
  559.                         default {
  560.                             global header3Color
  561.                             wwwMakeColourWord $name $header3Color 0
  562.                         }
  563.                     }
  564.                 } 
  565.                 insertText "\r\r"
  566.             }
  567.             "^COMMENT" {
  568.                 _wwwSplit t </COMMENT> pre
  569.             }
  570.             "^EMBED\\s+" {
  571.                 if {[regexp -nocase {src *= *"([^"]+)"} $html dummy embed]} {
  572.                     set name "???"
  573.                     regexp {[^/:]+$} $embed name
  574.                     wwwMakeLinkWord "Embedded '$name'." $embed
  575.                 }
  576.             }
  577.             "^/.*" {
  578.             }
  579.             default {
  580.                 set html [lindex $html 0]
  581.                 if {[regexp -nocase "^(\[^<\]*)</$html>(.*)\$" $t dummy name t]} {
  582.                     wrapInsertText $name
  583.                 }
  584.             }
  585.         }
  586.     }
  587.     wrapInsertText $t
  588. }
  589.  
  590. proc _wwwBreakIfNecessary {} {
  591.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} {
  592.         insertText "\r"
  593.     }
  594.     if {[lookAt [pos::math [getPos] - 2]] != "\r"} {
  595.         insertText "\r"
  596.     }
  597. }
  598. proc _wwwNewLineIfNecessary {} {
  599.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} {insertText "\r"}
  600. }
  601.  
  602. proc _wwwSplit {text at prefix} {
  603.     upvar $prefix a
  604.     upvar $text t
  605.     if {[set p [string first $at [string toupper $t]]] == -1} {
  606.         set a $t
  607.         set t ""
  608.     } else {
  609.         set a [string range $t 0 [expr $p -1]]
  610.         set t [string range $t [expr $p + [string length $at]] end]
  611.     }
  612. }
  613.     
  614. proc wrapInsertText {text} {
  615.     global _wwwPre
  616.     if {!$_wwwPre} {
  617.         regsub -all "\[\t\r\n \]+" [string trim $text] " " text
  618.     }
  619.     regsub -all " " $text " " text
  620.     regsub -all "&" $text {\&} text
  621.     regsub -all "<" $text "<" text
  622.     regsub -all ">" $text ">" text
  623.     regsub -all """ $text {"} text
  624.     if {$_wwwPre} {
  625.         insertText $text
  626.         return
  627.     }
  628.     if {$text == ""} { return }
  629.     set r [posToRowCol [getPos]]
  630.     set x [lindex $r 1]
  631.     global _wwwIndentation _wwwIndent
  632.     if {$x > 74} {
  633.         insertText "\r$_wwwIndent"
  634.         set x 0
  635.     }
  636.     if {$x == 0} { 
  637.         incr x $_wwwIndentation 
  638.     } else {
  639.         if {[regexp {^\w} $text]} {
  640.             if {[regexp {\w} [lookAt [pos::math [getPos] - 1]]]} {
  641.                 insertText " "
  642.                 incr x
  643.             }
  644.         }
  645.     }
  646.     set fc [expr 75 - $x]
  647.     while {[string length $text] > $fc} {
  648.         set f [string last " " [string range $text 0 $fc]]
  649.         if {$f == -1} {
  650.             set f $fc
  651.         }
  652.         insertText "[string range $text 0 $f]\r$_wwwIndent"
  653.         set text [string range $text [incr f] end]
  654.         set fc [expr 75 - $_wwwIndentation]
  655.     }
  656.     insertText $text
  657. }
  658.  
  659. proc wwwMakeColourWord {word ind ind2 {with ""}} {
  660.     wwwDoColour $ind $with
  661.     wrapInsertText $word
  662.     wwwDoColour $ind2 12
  663. }
  664.  
  665. proc wwwDoColour {ind {with ""}} {
  666.     set p [getPos]
  667.     insertColorEscape $p $ind
  668.     if {$with != ""} {
  669.         insertColorEscape $p $with
  670.     }
  671. }
  672.  
  673. proc wwwMakeColour {from to ind ind2} {
  674.     insertColorEscape $from $ind
  675.     insertColorEscape $to $ind2    
  676. }
  677.  
  678. proc wwwMakeLinkWord {word link} {
  679.     if {$word == ""} { return }
  680.     set p [getPos]
  681.     if {[regexp {\w} [lookAt [pos::math $p - 1]]]} {
  682.         insertText " "
  683.         set p [pos::math $p + 1]
  684.     }
  685.     set cmd "wwwLink [set link [string trim $link]]"
  686.     insertColorEscape $p [_wwwLinkColour $link]
  687.     insertColorEscape $p 15 $cmd    
  688.     wrapInsertText $word
  689.     set p [getPos]
  690.     insertColorEscape $p 12
  691.     insertColorEscape $p 0
  692. }
  693.  
  694. proc _wwwLinkColour {link} {
  695.     global linkColor visitedLinkColor _wwwVisited
  696.     if {[lsearch -exact $_wwwVisited [string trim $link {"}]] == -1} {
  697.         return $linkColor
  698.     } else {
  699.         return $visitedLinkColor
  700.     }
  701. }
  702.  
  703. proc wwwMakeLink {from to link} {
  704.     set cmd "wwwLink [set link [string trim $link]]"
  705.     insertColorEscape $from [_wwwLinkColour $link]
  706.     insertColorEscape $from 15 $cmd
  707.     insertColorEscape $to 12
  708.     insertColorEscape $to 0
  709. }
  710.  
  711. proc _wwwSynchroniseHistoryPos {} {
  712.     global _wwwHistory _wwwHpos
  713.     set w [win::Current]
  714.     regsub -all {[][]} $w {\\&} w
  715.     set _wwwHpos [lsearch -glob $_wwwHistory [list * $w]]
  716.     #set _wwwHistory [lrange $_wwwHistory 0 $_wwwHpos]    
  717. }
  718.  
  719. proc wwwVisited {to} {
  720.     global _wwwVisited
  721.     if {[lsearch -exact $_wwwVisited $to] == -1} {
  722.         lappend _wwwVisited $to
  723.     }
  724. }
  725.  
  726. proc wwwLink {to} {
  727.     wwwVisited $to
  728.     _wwwSynchroniseHistoryPos
  729.     if {[set l [string first ":" $to]] == -1} {
  730.         # it's local
  731.         _wwwSplit to "\#" pre
  732.         if {[string length $pre]} {
  733.             global wwwWhere
  734.             switch [file extension $pre] {
  735.                 ".class" - 
  736.                 ".java" {
  737.                     set pref "java"
  738.                 }
  739.                 default {
  740.                     set pref "file"
  741.                 }
  742.             }            
  743.             wwwLink "${pref}://[file dirname $wwwWhere([win::Current])]/$pre"
  744.         }
  745.         gotoMark $to
  746.         _wwwHighlightLink [lindex [wwwGetCurrentLink] 1]
  747.         return
  748.     }
  749.     set p [string trimleft [string range $to [expr $l +1] end] "/"]
  750.     set urlType [string range $to 0 [expr $l -1]]
  751.     global wwwUrlAction
  752.     if {[info exists wwwUrlAction($urlType)]} {
  753.         # do we handle this internally
  754.         global ${urlType}LinksInternal
  755.         global _wwwAlwaysInternal
  756.         if {[lsearch -exact $_wwwAlwaysInternal $urlType] != -1 \
  757.             || ([info exists ${urlType}LinksInternal] \
  758.             && [set ${urlType}LinksInternal]) } {
  759.             
  760.             $wwwUrlAction($urlType) $p
  761.             return
  762.         }
  763.     }
  764.     # if we didn't return above
  765.     wwwExternalLink $to
  766. }
  767.  
  768. proc _wwwMassagePath {pp} {
  769.     upvar $pp p
  770.     regsub -all "/" $p ":" p
  771.     regsub -all {[^:]+:\.\.:} $p "" p
  772. }
  773.  
  774. proc fileWWWLink {p} {
  775.     _wwwMassagePath p
  776.     global ModeSuffixes
  777.     if {[case [file extension $p] $ModeSuffixes] == "HTML"} {
  778.         wwwParseFile $p
  779.     } else {
  780.         file::openQuietly $p
  781.     }
  782. }
  783.  
  784. proc javaWWWLink {p} {
  785.     global runJavaAppletsDirectly
  786.     if {$runJavaAppletsDirectly} {
  787.         # can run applet directly
  788.         _wwwMassagePath p
  789.         alertnote "Sorry, I don't yet know how to run .class files directly."
  790.         javaRun "[file root ${p}].class"
  791.     } else {
  792.         # use html file
  793.         global javaviewerSig _wwwHistory _wwwHpos
  794.         set app [file tail [app::launchFore $javaviewerSig]]
  795.         sendOpenEvent -n $app [lindex [lindex $_wwwHistory $_wwwHpos] 0]
  796.     }
  797. }
  798.  
  799. proc ftpWWWLink {p} {
  800.     url::parseFtp $p i
  801.     ftpBrowse $i(host) $i(path) $i(user) $i(pass) $i(file)
  802. }
  803.  
  804. proc wwwExternalLink {to} {
  805.     global wwwSendRemoteLinks
  806.     if {$wwwSendRemoteLinks} {
  807.         icURL $to
  808.     } else {
  809.         alertnote "External link to $to, toggle this mode's flags to use a helper instead of this message."
  810.     }
  811. }
  812.  
  813. proc wwwForward {} {
  814.     global _wwwHistory _wwwHpos
  815.     if {$_wwwHpos < [expr [llength $_wwwHistory] -1]} {
  816.         incr _wwwHpos
  817.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  818.     } else {
  819.         beep
  820.         message "Already at most recent document."
  821.     }
  822. }
  823.  
  824. proc wwwReload {} {
  825.     global _wwwHistory _wwwHpos
  826.     killWindow
  827.     eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  828. }
  829.  
  830. proc wwwBack {} {
  831.     global _wwwHistory _wwwHpos
  832.     if {$_wwwHpos > 0} {
  833.         incr _wwwHpos -1
  834.         eval _wwwParseFile [lindex $_wwwHistory $_wwwHpos]
  835.     } else {
  836.         beep
  837.         message "Already at first document."
  838.     }
  839. }
  840.  
  841. proc wwwSelectLink {} {
  842.     set link [wwwGetCurrentLink]
  843.     set link [_wwwHighlightLink [lindex $link 0]]
  844.     set p [getPos]
  845.     set q [selEnd]
  846.     select $p $p
  847.     select $p $q
  848.     wwwLink $link
  849. }
  850.  
  851. proc wwwEditLinkedDocument {} {
  852.     set to [_wwwHighlightLink [lindex [wwwGetCurrentLink] 0]]
  853.     if {[set l [string first ":" $to]] == -1} {
  854.         # it's local
  855.         _wwwSplit to "\#" pre
  856.         global wwwWhere
  857.         if {[string length $pre]} {
  858.             _wwwEditLinkedDoc "file://[file dirname $wwwWhere([win::Current])]/$pre"
  859.         } else {
  860.             _wwwEditLinkedDoc "file://$wwwWhere([win::Current])"
  861.         }
  862.         return
  863.     }
  864.     _wwwEditLinkedDoc $to
  865. }
  866.  
  867. proc _wwwEditLinkedDoc {to} {
  868.     set l [string first ":" $to]
  869.     set p [string trimleft [string range $to [expr $l +1] end] "/"]
  870.     _wwwMassagePath p
  871.     if {[catch {file::openQuietly $p}]} {
  872.         alertnote "Sorry, I can't edit and/or find that document."
  873.     }
  874. }
  875.  
  876. proc wwwModifyLink {} {
  877.     global mode
  878.     if {$mode != "WWW"} {
  879.         alertnote "Only useful in WWW browser mode."
  880.         return
  881.     }
  882.     
  883.     global _wwwHistory _wwwHpos
  884.     set f [lindex [lindex $_wwwHistory $_wwwHpos] 0]
  885.     if {![file exists $f]} {
  886.         alertnote "Sorry, I couldn't find that file!"
  887.     }
  888.     set w [win::Current]
  889.     if {![catch {getWinInfo -w $f i}]} {
  890.         if {$i(dirty)} {
  891.             message "Saving original file."
  892.             bringToFront $f
  893.             save
  894.             bringToFront $w
  895.         }
  896.     }
  897.     set link [wwwGetCurrentLink]
  898.     _wwwHighlightLink [lindex $link 0]
  899.     set p [getPos]
  900.     set q [selEnd]
  901.     regexp "\{ $p 15 \{wwwLink \"(\[^\"\]*)\"\} \} \{ $q 12 \}" [getColors] dmy link
  902.     set link "\"$link\""
  903.     set to [getline "Enter new link location" $link]
  904.     if {$to == "" || $to == $link} {
  905.         return
  906.     }
  907.     if {![regexp {^"} $to]} { set to "\"$to" }
  908.     if {![regexp {"$} $to]} { append to {"} }
  909.     set link [quote::Regfind $link]
  910.     set to [quote::Regsub $to]
  911.     set cid [open $f "r"]
  912.     if {[regsub -all -- $link [read $cid] $to out]} {
  913.         set ocid [open $f "w+"]
  914.         puts -nonewline $ocid $out
  915.         close $ocid
  916.         message "Updated original."
  917.     }
  918.     close $cid
  919.     if {![catch {bringToFront $f}]} {
  920.         message "Updating window to agree with disk version."
  921.         revert
  922.         bringToFront $w
  923.     }
  924.     setWinInfo read-only 0    
  925.     wwwMakeLink    $p $q $to
  926.     setWinInfo read-only 1    
  927. }
  928.  
  929. proc wwwUp {} {
  930.     set link [wwwGetCurrentLink]
  931.     _wwwHighlightLink [expr [lindex $link 1] -1]        
  932. }
  933.  
  934. proc wwwDown {} {
  935.     set link [wwwGetCurrentLink]
  936.     _wwwHighlightLink [expr [lindex $link 0] +1]        
  937. }
  938.  
  939. proc _wwwHighlightLink {l} {
  940.     global _wwwLinks
  941.     if {[set len [llength $_wwwLinks]] == 0} {return}
  942.     if {$l < 0 || $l >= $len} {
  943.         set l [expr ($l + $len) % $len]
  944.         beep
  945.     }
  946.     set link [lindex $_wwwLinks $l]
  947.     eval select $link
  948.     set p [getPos]
  949.     set q [selEnd]
  950.     regexp "\{ $p 15 \{wwwLink \"(\[^\"\]*)\"\} \} \{ $q 12 \}" [getColors] dmy link
  951.     message "Links to '$link'"
  952.     return $link
  953. }
  954.  
  955. proc wwwHighlightLink {l} {
  956.     global _wwwLinks
  957.     set _wwwLinks [_wwwGetLinks]
  958.     _wwwHighlightLink $l
  959. }
  960.  
  961. proc wwwGetCurrentLink {} {
  962.     global _wwwLinks
  963.     set _wwwLinks [_wwwGetLinks]
  964.     set p [getPos]
  965.     set i 0
  966.     while 1 {
  967.         if {[set j [lindex [lindex $_wwwLinks $i] 0]] == ""} {
  968.             return [list [expr $i-2] [expr $i-1]]
  969.         }
  970.         if {$p <= $j} {
  971.             if {$p == $j} {
  972.                 return [list $i $i]
  973.             } else {
  974.                 return [list [expr $i-1] $i]
  975.             }
  976.         }
  977.         incr i
  978.     }
  979.     incr i -1
  980.     return [list $i $i]
  981. }
  982.  
  983. proc wwwCopyLinkLocation {} {
  984.     alertnote "Unimplemented."
  985. }
  986.  
  987. proc _wwwGetLinks {} {
  988.     regsub -all {\{wwwLink "[^"]*"\} } [getColors] "" g
  989.     # remove all non 12,15 items
  990.     regsub -all {\{ [0-9]+ ([0-9]|1[0134]) \} ?} $g "" g
  991.     # remove superimposed links (caused by editing)
  992.     regsub -all {(\{ [0-9]+ 15 \} )+(\{ [0-9]+ 15 \} ?)} $g {\2} g
  993.     # convert 15-12 list pairs into single items
  994.     regsub -all { ([0-9]+) 15 \} \{ ([0-9]+) 12 } $g {\1 \2} g
  995.     # remove random left-overs items
  996.     regsub -all {\{ [0-9]+ 12 \} ?} $g "" g
  997.     return $g
  998. }
  999.  
  1000.  
  1001.  
  1002.  
  1003.  
  1004.